Data Analysis on Retail Data

Date: 21/04/16
Author: Jonathan Chan
Description: Data Analysis on Retail Data

1 Initial Data Loading

library("tidyverse")
library("lubridate")
library("ggmap")
library("plotly")
library("viridis")
library("wesanderson")
library("DT")

Initialising data, which includes original data and new data, joining them to create a master set.

info <- read.table("./Data/All_info.txt", header = TRUE, na.strings = c("", "NA"), 
                   stringsAsFactors = FALSE)
info_new <- read.csv("./Data/All_info(new)-1.csv", stringsAsFactors = FALSE, header = TRUE,
                     na.strings = c("", "NA"))
colnames(info_new) <- colnames(info)
info_temp <- rbind(info, info_new)
info_walk <- read.csv("./Data/info walk-1.csv", stringsAsFactors = FALSE)

Overall there are 6429 rows of data. With 1173 unique customers.

Converts the dates in character format to date format and calculate age from date of birth. Redacted a lot of columns

info_merge <- info_temp
info_merge$Order.date <- dmy(info_temp$Order.date)
info_merge$D.O.B. <- dmy(info_temp$D.O.B.)
info_merge <- info_merge %>% mutate(Age = year(as.period(interval(info_merge$D.O.B., "21/04/16"))))
select(info_merge[45:54, ], -c(Name, Post, D.O.B., Age, Sex, Gross.profit, Amount.1, Value, Order.value, Net.Order.Value, Proj..Value.w.o.discount, Proj..Cost.of.sales, Amount))

2 Category Analysis

To start of with some data cleansing to merge different type of horn products into a single group.

info_merge$Material <- gsub(pattern = "Buffalo Horn", replace = "Horn", x = info_merge$Material)
info_merge$Material <- gsub(pattern = "Carbon Horn", replace = "Horn", x = info_merge$Material)
info_merge$Material <- gsub(pattern = "Thin Horn", replace = "Horn", x = info_merge$Material)

2.1 By Material

2.1.1 Material with Age

material_plot <- ggplot(filter(info_merge, Age > 0 & Age < 100, 
              Material %in% c("Acetate", "Horn", "Combination", "Titanium", "Rimless")), 
             aes(x = Material, y = Age, fill = Material)) +
  theme(axis.text.y=element_blank()) +
  geom_boxplot() +
  geom_jitter(alpha = 0.2) +
  scale_fill_viridis(discrete=T) +
  geom_violin(alpha = 0.25)
  ggtitle("Frame Material with Age")

$`title`
[1] "Frame Material with Age"

$subtitle
NULL

attr(,"class")
[1] "labels"

# ggplotly(material_plot, width = 900)
  material_plot

mat.type <- data.frame()
mat.type <- info_merge %>%
  filter(Product.type %in% c("Frames", "Sunglasses"),
         Material %in% c("Acetate", "Horn", "Combination", "Titanium", "Rimless"),
         Amount > 0,  # takes only frames made by TD
         is.na(Sex) == FALSE) %>%
  group_by(Product.type, Material, Sex) %>%
  summarise(orders = n(), Total.Order.value = sum(Amount, na.rm = TRUE), no.customers = n_distinct(Name))
mat.type <- mutate(mat.type, 
              Percentage.Orders = orders/sum(mat.type$orders),  # Creates profit/order and % of orders
              Percentage.Order.Value = Total.Order.value/sum(mat.type$Total.Order.value),
              Average.Order.value = Total.Order.value/orders,
              Order.customer.ratio = orders/no.customers)

2.2 Lens Analysis

Lens_type <- info_merge %>% 
  filter(Product.type == "Lenses") %>%
  group_by(Lens.type) %>%
  summarise(number = n())

2.2.1 Lens Type with Age

Lens_data <- subset(info_merge, Age > 0 & Age < 100 & Lens.type != "Bifocal")
Lens_data$Lens.type <- factor(Lens_data$Lens.type, levels = c("Single vision", "Progressive"))
# ggplotly(
  ggplot(Lens_data, aes(x = Lens.type, y = Age)) +
    geom_boxplot() +
    theme(axis.text.y=element_blank()) +
    geom_jitter(alpha = 0.2) +
    geom_violin(alpha = 0.25)#,

#   width = 900
# )

2.2.2 Lens Coatings/Finishes by Age

3 Age Patterns

3.1 Age distribution

customers_age <- info_merge %>% filter(Age < 100, Age > 0, Amount > 0)
#  Histogram of frequency of customers of certain age
# ggplotly(
  ggplot(customers_age %>% distinct(Name, Age), aes(Age)) +
        theme(axis.text.y=element_blank(), axis.text.x=element_blank()) +
        geom_histogram(binwidth = 5, alpha = 0.8, col = "white") +
        scale_x_continuous(breaks = seq(0, 100, 5))#,

#   width = 900
# )

3.2 Total Spend against Age (For Each Customer)

Total_spend <- customers_age %>% 
                group_by(Name) %>% 
                summarise(Total.Spend = sum(Amount), Age = mean(Age))
# ggplotly(
  ggplot(Total_spend, aes(x = Age, y = Total.Spend)) + 
    theme(axis.text.y=element_blank()) +
    geom_point(shape = 1) +
    geom_smooth() +
    scale_x_continuous(breaks = seq(0, 100, 5)) +
    scale_y_continuous(breaks = seq(0, 10000, 1000))#,

#   width = 900
# )

3.3 Average Total Spend by Age

3.3.1 Regression Plot

Average_spend <- customers_age %>% 
  group_by(Name) %>% 
  summarise(Total.Spend = sum(Amount), Age = mean(Age)) %>%
  group_by(Age) %>% 
  summarise(Average.spend = mean(Total.Spend))
# ggplotly(
  ggplot(Average_spend, aes(x = Age, y = Average.spend)) + 
    theme(axis.text.y=element_blank()) +
    geom_point(shape = 1) +
    geom_smooth(method = "lm", formula = y ~ poly(x, 3)) +
    scale_x_continuous(breaks = seq(0, 100, 10)) +
    scale_y_continuous(breaks = seq(0, 10000, 100)) + 
    ggtitle("Regression of Average Spend with Age (3rd Order Polynomial)")#,

#   width = 900
# )

3.3.2 Model Summary

Redacted

3.3.3 Diagnostic Plots

Redacted

3.4 Frame cost and age

Product_age <- info_merge %>%
  filter(Product.type %in% c("Frames", "Sunglasses"), Amount > 0, Age > 0, Age < 100, Amount < 2500)
# ggplotly(
  ggplot(Product_age, aes(x = Age, y = Amount)) + 
    theme(axis.text.y=element_blank()) +
    geom_point(shape = 1) +
    geom_smooth()#,

#   width = 900
# )

3.5 Customer Age Group - Customer Count and Spend

3.6 Purchase Frequency with Age

4 Visit Statistics

All charts are redacted ## Total number of purchases per customer

4.1 Total number of visits per customer

4.2 Number of purchases per visit

4.3 Number of Days Between Visits

4.4 Cumulative Graph of Number of Days to Customer Next Visit

If a customer visits again, 60% of the time a customer they will return within the first 90 days since their last visit.

ggplotly(
  ggplot(visits %>% arrange(days_next_visit), aes(days_next_visit)) + 
    stat_ecdf(geom = "step", col = "blue", size = 0.5) +
    scale_x_continuous(breaks = seq(0, 600, 30)) +
    scale_y_continuous(breaks = seq(0, 1, 0.1)) +
    ylab("Percentage"),
  width = 900
)

Removed 903 rows containing non-finite values (stat_ecdf).

4.5 Customer ranking and percentile calculations

Note that table data has been redacted

5 Sales with Time

5.1 individual sales with time

# ggplotly(
  ggplot(info_merge %>% filter(Amount > 0), aes(x = Order.date, y = Amount)) +
    theme(axis.text.y=element_blank()) +
    geom_point(shape = 1) +
    geom_smooth()#,

#   width = 900
# )

5.2 total daily sales with time

Sales_by_date <- info_merge %>% 
                  group_by(Date = Order.date) %>% 
                  summarise(Sales = sum(Amount, na.rm = TRUE))
# ggplotly(
  ggplot(Sales_by_date, aes(x = Date, y = Sales)) +
    theme(axis.text.y=element_blank()) +
    geom_point(shape = 1) +
    geom_smooth()#,

#   width = 900
# )

5.3 total monthly sales with time

Monthly sales appear to rise and then tapper off, but the time frame is short so it might be a blip.

Sales_by_month <- info_merge %>% 
  mutate(Month = floor_date(Order.date, "month")) %>%
  group_by(Month) %>% 
  summarise(month_sales = sum(Amount, na.rm = T))
# September sales is incomplete so excluded in this case
# ggplotly(
  ggplot(Sales_by_month, aes(x = Month, y = month_sales, ymin = 0)) +  
     theme(axis.text.y=element_blank()) +
    geom_point(size = 2) +
    geom_smooth()

#   width = 900
# )

5.4 unique customers plot earliest purchase date

Drop in sales might be due to drop in new customer acquisition rate.

6 Customer location mapping

post_codes <- read.csv("./Data/Postcodes.csv")
post_codes <- post_codes[ ,1]
coordinates <- read.csv("Postcodes coordinates.csv")
## install for newest verion of ggmap
#if(!requireNamespace("devtools")) install.packages("devtools")
#devtools::install_github("dkahle/ggmap", ref = "tidyup")
register_google(key = "AIzaSyD88nanfnGGg2iH5GqWsnznlNgad3SiBd4")

6.1 UK

90% of customers are located in the UK

ggmap(get_map("Machester", zoom = 6, api_key = key), extent = "device") +
  geom_point(aes(x = lon, y = lat), data = coordinates,
             alpha = .15, color="darkred", size = 2)

Source : https://maps.googleapis.com/maps/api/staticmap?center=Machester&zoom=6&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
Source : https://maps.googleapis.com/maps/api/geocode/json?address=Machester&key=xxx

6.2 Greater London

60% of all customers are located in London

ggmap(get_map("SW1W", zoom = 11, api_key = key), extent = "device") +
  geom_point(aes(x = lon, y = lat), data = coordinates,
             alpha = .15, color="darkred", size = 2)

Source : https://maps.googleapis.com/maps/api/staticmap?center=SW1W&zoom=11&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
Source : https://maps.googleapis.com/maps/api/geocode/json?address=SW1W&key=xxx

6.3 London

ggmap(get_map("SW1W", zoom = 12, api_key = key), extent = "device")+
  geom_point(aes(x = lon, y = lat), data = coordinates,
             alpha = .2, color="darkred", size = 2)

Source : https://maps.googleapis.com/maps/api/staticmap?center=SW1W&zoom=12&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
Source : https://maps.googleapis.com/maps/api/geocode/json?address=SW1W&key=xxx

6.4 London 2

ggmap(get_map("SW1W", zoom = 13, api_key = key), extent = "device")+
  geom_point(aes(x = lon, y = lat), data = coordinates,
             alpha = .25, color="darkred", size = 2)

Source : https://maps.googleapis.com/maps/api/staticmap?center=SW1W&zoom=13&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
Source : https://maps.googleapis.com/maps/api/geocode/json?address=SW1W&key=xxx

6.5 Sloane Square

ggmap(get_map("Sloane Square", zoom = 14, api_key = key), extent = "device")+
  geom_point(aes(x = lon, y = lat), data = coordinates,
             alpha = .25, color="darkred", size = 2)

Source : https://maps.googleapis.com/maps/api/staticmap?center=Sloane%20Square&zoom=14&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
Source : https://maps.googleapis.com/maps/api/geocode/json?address=Sloane%20Square&key=xxx

7 Spending by Regions

8 Walking Distance from Store

distance <- data.frame()
# $V1 takes it as a vector instead of data frame
London_regions <- read.csv("./Data/London Town and Boroughs.csv", stringsAsFactors = FALSE, header = FALSE)$V1
Post_code_regex <- "^([A-PR-UWYZ0-9][A-HK-Y0-9][AEHMNPRTVXY0-9]?[ABEHMNPRVWXY0-9]? {1,2}[0-9][ABD-HJLN-UW-Z]{2}|GIR 0AA)$"
London_cust <- info %>% 
  filter(grepl(Post_code_regex, Post), tolower(Town) %in% tolower(London_regions), Amount > 0) %>%
  distinct(Post)

8.1 Histogram of Walking Distance

# ggplotly(
ggplot(walking_dist, aes(minutes)) +
  theme(axis.text.y=element_blank()) +
  geom_histogram(position = 'stack', binwidth = 5, alpha = 0.9, col = "white", boundary = 0)#,

#   width = 900
# )

8.2 Cumulative Graph of Walking Distance from Store

Only 30% of customers live within a 30 minute walk from the store. Some may work nearby, or the store may be a destination store instead of relying on local clientel.

ggplotly(
  ggplot(walking_dist %>% arrange(minutes), aes(minutes)) + 
    stat_ecdf(geom = "step", col = "blue", size = 0.5) +
    scale_x_continuous(breaks = seq(0, 300, 15)) +
    scale_y_continuous(breaks = seq(0, 1, 0.1)) +
    ylab("Percentage") +
    ggtitle("Walking Distance from Store"),
  width = 900
)

9 Age Demographics Comparison

# Categorises customer numbers and spending into age categories and filters by proximity of 45 min walk
age_summary <- function(lower, upper){
  info_walk %>% 
    group_by(Name) %>% 
    summarise(spend = sum(Amount, na.rm = TRUE), Age = Age[1], minutes = minutes[1]) %>%  # as each name has multiple only take 1st age&min
    filter(Age >= lower, Age <= upper, spend > 0, minutes > 30) %>% 
    summarise(count = n_distinct(Name))
}
# Census data
census <- read.csv("./Census data/Census area summary.csv", stringsAsFactors = FALSE)
TD_count <- mapply(age_summary, lower = census$Lower, upper = census$Upper)
TD_count <- matrix(unlist(t(TD_count)), ncol = 1)  #Transposes then converts the list to a matrix
colnames(TD_count) <- "TD_count"
census_sum <- cbind(census, TD_count)
census_sum <- mutate(census_sum, count_percent = TD_count/sum(TD_count))
age_group <- paste(census_sum[ ,1], "-", census_sum[ ,2], sep = "")
comparison <- cbind(age_group, census_sum[,3:6])
colnames(comparison) <- c("age_group", "Count", "Census", "TD_count", "TD customers")
comp_long <- cbind(age_group, gather(comparison[,2:5]))
comp_long <- subset(comp_long, key %in% c("Census", "TD customers"))
# keep data as factors, otherwise it sorts by numerical order
comp_long$age_group <- factor(comp_long$age_group, levels = unique(comp_long$age_group))
comp_long$key <- factor(comp_long$key, levels = unique(comp_long$key))

For age comparison it only looks at 160 out of 940 customer, after filtering for 45min walking proximity, age data and spending. Overall compared to the local area the store attracts a much larger proportion of those aged between 45-59 compared to other ages groups.

comp_long <- comp_long %>% mutate(percent = value*100)
# ggplotly(
  ggplot(comp_long, aes(x = age_group, y = percent, fill = key)) +
    theme(axis.text.x=element_blank()) +
    geom_bar(stat = "identity", position = position_dodge()) +
    xlab("Age Categories") +
    ylab("Percentage") +
    ggtitle("Comparison of Age Groups (2011 K&C Census vs Store)") +
    scale_y_continuous(breaks = seq(0, 100, 10))#,

#   width = 900,
#   height = 500
# )